home *** CD-ROM | disk | FTP | other *** search
Wrap
Text File | 1994-01-17 | 41.1 KB | 1,302 lines | [ TEXT/MPS ]
// Who we are: constant kAppSymbol := '|TapBoard:Chesley|; constant kPackageName := "TapBoard:Chesley"; // Each square on the board can be empty, contain a newton piece, or contain // a user piece; for the convenience of the computer move algorithms, the // board array is made one square larger in each directions and the edges are // filled in with a special value (0). Also note that if p is one player, -p is // the other player. These constants are also used to indicate whose turn it is. constant kEmptySquare := nil; constant kNewtonPiece := -1; constant kUserPiece := 1; constant kBoardEdge := 0; constant kTieWinner := 0; RemoveScript := func(packageFrame) begin local cursor := Query(GetStores()[0]:GetSoup(ROM_SystemSoupName), {type: 'index, indexPath: 'tag, startKey: kPackageName, validTest: func(item) StrEqual(item.tag, kPackageName)}); if cursor:Entry() <> nil then EntryRemoveFromSoup(cursor:Entry()); end; // ---- End Project Data ---- BoardGames := { viewSetupDoneScript: func() begin // Find the saved state local stateEntry := :getStateEntry(); // Is there one? if stateEntry = nil then // If not, default to the first radio button gamePicker:setClusterValue(1) else begin // If there is, restore the state from the entry gamePicker:setByName(stateEntry.name); currentBoard:restoreState(stateEntry); end; end, viewQuitScript: func() begin // If any board is displayed (which it always will be-- // we're just being paranoid), save the current state if currentBoard <> nil then currentBoard:saveState(); end, announceCredits: func() begin credits:Open(); end, announceWin: func(p) begin // First, make sure the current game display is up to date RefreshViews(); // Then bring up the right glance view if p = kUserPiece then youWin:Open() else if p = kNewtonPiece then iWin:Open() else tie:Open(); end, stopWorking: func() begin working:Close(); end, turn: func(p) begin userOrComputer:SetClusterValue(p); end, viewBounds: {top: 0, left: 0, right: 240, bottom: 336}, whoseTurn: func() begin return userOrComputer.clusterValue; end, _proto: protoapp, viewJustify: 16, currentBoard: nil, title: "TapBoard", viewSetupFormScript: func() begin boardList := []; // Remember the original dimensions in case we need them local originalWidth := viewBounds.right - viewBounds.left; local originalHeight := viewBounds.bottom - viewBounds.top; // Default the app bounds to the screen bounds (nice on small screens) local ap := GetAppParams(); self.viewBounds := RelBounds(0, ap.appAreaTop, ap.appAreaWidth, ap.appAreaHeight); // But if the screen's too large for that to look good, center it // (We allow for a range of screen sizes to handle future screens) if ap.appAreaWidth > (originalWidth+20) then self.viewBounds.right := originalWidth; if ap.appAreaHeight > (originalHeight+20) then begin self.viewBounds.top := ap.appAreaTop + (ap.appAreaHeight - originalHeight) div 2; self.viewBounds.bottom := self.viewBounds.top + originalHeight; end; end, isTurn: func(p) begin return p = userOrComputer.clusterValue; end, announceHelp: func() begin help:Open(); end, boardList: nil, startWorking: func() begin // Open the view working:Open(); // Then force a refresh of anything that might need it; we're // about to do lots of time-consuming work, so the system won't // get a chance to do this otherwise RefreshViews(); end, viewEffect: 133120, getStateEntry: func() begin // Find our one-and-only entry in the System soup, if there is one return Query(GetStores()[0]:GetSoup(ROM_SystemSoupName), {type: 'index, indexPath: 'tag, startKey: kPackageName, validTest: func(item) StrEqual(item.tag, kPackageName)}):Entry(); end, newGame: func(nm) begin // Look through all the boards local b; foreach b in boardList do // Are we looking for the one that's currently displayed? if nm = nil then begin // If so, and if this is it, then clear it if Visible(b) then b:clearBoard(); end // If not, check if this is the one that's been specified else if StrEqual(b.name, nm) then begin // Set the current board, clear it, show, and set the piece icons currentBoard := b; b:clearBoard(); b:Show(); player1Sample.icon := b.player1Piece; player1Sample:Dirty(); player2Sample.icon := b.player2Piece; player2Sample:Dirty(); end // If this isn't it, then hide it (harmless if already hidden) else b:Hide(); // Always start with the user's turn :turn(kUserPiece); end }; userOrComputer := /* child of BoardGames */ {viewBounds: {top: -119, left: 0, right: 175, bottom: -102}, clusterValue: 1, viewJustify: 144, _proto: protoradiocluster }; _view000 := /* child of userOrComputer */ {buttonValue: 1, viewBounds: {left: 9, top: 0, right: 73, bottom: 16}, text: "Your Move", _proto: protoradiobutton }; _view001 := /* child of userOrComputer */ {buttonValue: -1, viewBounds: {left: 81, top: 0, right: 185, bottom: 16}, text: "Computer's Move", _proto: protoradiobutton }; // View userOrComputer is accesible from BoardGames player2Sample := /* child of BoardGames */ {viewflags: 529, icon: nil, viewFormat: 256, viewBounds: {top: -100, left: 42, right: 74, bottom: -68}, thePicture: GetPictAsBits("BPPicture", nil), viewClickScript: func(unit) begin // No ink (we're tapping, not drawing) InkOff(unit); // Make a nice little click to give the user warm fuzzies PlaySound(ROM_click); // Make it the Newton's turn :turn(kNewtonPiece); return true; end, viewJustify: 144, viewclass: 76 }; // View player2Sample is accesible from BoardGames player1Sample := /* child of BoardGames */ {viewflags: 529, icon: nil, viewFormat: 256, viewBounds: {top: -100, left: -42, right: -10, bottom: -68} , thePicture: nil, viewClickScript: func(unit) begin // No ink (we're tapping, not drawing) InkOff(unit); // Make a nice little click to give the user warm fuzzies PlaySound(ROM_click); // Make it the user's turn :turn(kUserPiece); return true; end, viewJustify: 144, viewclass: 76 }; // View player1Sample is accesible from BoardGames iWin := /* child of BoardGames */ {viewBounds: {top: -121, left: 0, right: 218, bottom: -63}, viewEffect: 54659072, text: "I win!\nThat was easy!", viewfont: fancyFont12+tsBold, viewJustify: 150, viewIdleFrequency: 10000, viewflags: 512, _proto: protoglance }; // View iWin is accesible from BoardGames youWin := /* child of BoardGames */ {viewBounds: {top: -121, left: 0, right: 218, bottom: -63}, viewEffect: 54659072, text: "You win!\nProbably just luck...", viewfont: fancyFont12+tsBold, viewJustify: 150, viewIdleFrequency: 10000, viewflags: 512, _proto: protoglance }; // View youWin is accesible from BoardGames tie := /* child of BoardGames */ {viewBounds: {top: -121, left: 0, right: 218, bottom: -63}, viewEffect: 54659072, text: "It's a tie!\nLet's play again.", viewfont: fancyFont12+tsBold, viewJustify: 150, viewIdleFrequency: 10000, viewflags: 512, _proto: protoglance }; // View tie is accesible from BoardGames credits := /* child of BoardGames */ {viewBounds: {top: 0, left: 0, right: 200, bottom: 280}, viewflags: 528, viewFormat: 67175153, viewJustify: 80, _proto: protofloatngo }; _view002 := /* child of credits */ {text: "TapBoard 1.1.1\nby\nHarry R. Chesley", viewBounds: {left: 0, top: 25, right: 180, bottom: 81}, viewJustify: 18, viewfont: fancyFont12+tsBold, _proto: protostatictext }; _view003 := /* child of credits */ {viewflags: 1, viewFormat: 256, viewLineSpacing: 12, viewfont: fancyFont10, viewBounds: {left: 0, top: 97, right: 181, bottom: 273}, text: "TapBoard is a collection of\ntap-to-move board games for\nthe Newton\u2122\u. If you like it,\nsend me Newton-mail and let\nme know.\n\nTapBoard is public domain.\nYou may freely distribute\nit, but must include this\nnotice.\n\nEnjoy." , viewJustify: 18, viewclass: 81 }; // View credits is accesible from BoardGames _view004 := /* child of BoardGames */ {viewBounds: {top: -16, left: 101, right: 131, bottom: -3}, text: "Help", buttonClickScript: func() begin :announceHelp(); end, viewJustify: 8388742, _proto: prototextbutton }; _view005 := /* child of BoardGames */ {text: "New Game", buttonClickScript: func() begin :newGame(nil); end, viewBounds: {top: -16, left: 29, right: 91, bottom: -3}, viewJustify: 8388742, _proto: prototextbutton }; _view006 := /* child of BoardGames */ {viewBounds: {top: -16, left: 141, right: 187, bottom: -3}, text: "Credits", buttonClickScript: func() begin :announceCredits(); end, viewJustify: 8388742, _proto: prototextbutton }; working := /* child of BoardGames */ {viewBounds: {top: -57, left: 0, right: 218, bottom: -31}, text: "Working...", viewfont: fancyFont18+tsBold, viewJustify: 8388758, viewflags: 16, viewFormat: 66129, viewEffect: 0, viewLineSpacing: 20, viewclass: 81 }; // View working is accesible from BoardGames help := /* child of BoardGames */ {viewBounds: {top: 0, left: 0, right: 200, bottom: 290}, viewflags: 528, viewFormat: 67175153, viewJustify: 90, currentHelp: 0, selectHelp: func(x) begin SetValue(mainText, 'text, GetVar(helpSyms[x])); end, viewSetupDoneScript: func() begin :selectHelp(0); end, helpSyms: ['generalHelp, 'tictactoeHelp, 'gomokuHelp, 'reversiHelp], generalHelp: "Just tap in a square to make\na move there.\n\nIf you want the computer to\nmove first, click on the\n\"Computer's Move\" radio\nbutton. If you want to \"pass\"\n(which is illegal in Tic-tac-\ntoe and Gomoku, but the\nprogram still lets you do it),\nclick on \"Computer's Move\".\n\nWhile the computer is\nworking on its move, the\n\"Computer's Move\" radio\nbutton is set, and a big\n\"Working\" sign comes up.\nWhen the computer is done,\nor it decides to \"pass,\"\nthe \"Your Move\" radio\nbutton will be set." , tictactoeHelp: "Tic-tac-toe is the classic\ngame, played on a 3-by-3\nboard. You try to get three\nin a row, vertical, horizontal,\nor diagonal, before the\ncomputer does the same.\n\nIt's not too hard to beat\nthe computer. But if you want\nmore of a challenge, let the\ncomputer move first by\nclicking on the \"Computer's\nMove\" radio button at the\nstart of the game." , gomokuHelp: "Try for five in a row before\nthe computer does. The row\ncan be vertical, horizontal,\nor diagonal.\n\nIt's possible to beat the\ncomputer, but it isn't easy." , reversiHelp: "Try to end up with more\npieces than the computer\ndoes when there are no\nmore legal moves.\n\nEach move must \"trap\" some\nof your opponent's pieces\nbetween two of your pieces.\nAll the trapped pieces\nflip over to become your\npieces (hence the name).\n\nIf you can't move, you\ncan \"pass\" by tapping on the\n\"Computer's Move\" radio\nbutton. The computer may do\nthe same by setting the \"Your\nMove\" radio button." , _proto: protofloatngo }; _view007 := /* child of help */ {viewBounds: {left: 18, top: 10, right: 175, bottom: 24}, labelCommands: ["General", "Tic-tac-toe", "Gomoku", "Reversi"], text: "Help Topic:", viewfont: ROM_fontSystem9Bold, labelActionScript: func(cmd) begin :selectHelp(cmd); end, viewJustify: 8388624, _proto: protolabelpicker }; mainText := /* child of help */ {viewflags: 17, viewFormat: 256, viewLineSpacing: 12, viewfont: fancyFont10, viewBounds: {top: 27, left: 0, right: 180, bottom: 299}, text: "foo", viewJustify: 18, viewclass: 81 }; // View mainText is accesible from help // View help is accesible from BoardGames _view008 := /* child of BoardGames */ {viewflags: 529, viewFormat: nil, viewBounds: {left: 0, top: 0, right: 240, bottom: 16}, viewClickScript: func(unit) begin PlaySound(ROM_click); :announceCredits(); end, viewclass: 74 }; gamePicker := /* child of BoardGames */ {viewBounds: {top: -51, left: 0, right: 215, bottom: -36}, ClusterChanged: func() begin // Find the name of the new button foreach t in stepChildren do if t.buttonValue = clusterValue then begin // Found it, start a new game of that name :newGame(t.text); return; end end, setByName: func(nm) begin // Find the radio button with this name, and set it local t; foreach t in :ChildViewFrames() do if StrEqual(t.text,nm) then begin if clusterValue <> t.buttonValue then :setClusterValue(t.buttonValue); return; end end, viewJustify: 144, _proto: protoradiocluster }; _view009 := /* child of gamePicker */ {viewBounds: {left: 7, top: -1, right: 86, bottom: 15}, text: "Tic-tac-toe", buttonValue: 1, _proto: protoradiobutton }; _view010 := /* child of gamePicker */ {buttonValue: 2, viewBounds: {left: 87, top: -1, right: 151, bottom: 15}, text: "Gomoku", _proto: protoradiobutton }; _view011 := /* child of gamePicker */ {buttonValue: 3, viewBounds: {left: 151, top: -1, right: 207, bottom: 15}, text: "Reversi", _proto: protoradiobutton }; // View gamePicker is accesible from BoardGames Board := { makeComputerMove: func() begin // By default, we just do something random // This is always overridden :makeRandomMove(kNewtonPiece); end, squareBounds: func(x, y) begin local width := :squareWidth(); local height := :squareHeight(); return RelBounds((x-1)*width+1, (y-1)*height+1, width-1, height-1); end, player2Piece: GetPictAsBits("BPPicture", nil), viewSetupDoneScript: func() begin // Build the board display // This builds a closed set of squares, but can be overridden local height := :LocalBox().bottom-1; local width := :LocalBox().right-1; backgroundDrawing := []; local x; for x := 0 to width by :squareWidth() do AddArraySlot(backgroundDrawing, MakeLine(x,0,x,height)); local y; for y := 0 to height by :squareHeight() do AddArraySlot(backgroundDrawing, MakeLine(0,y,width,y)); end, viewFormat: 256, viewDrawScript: func() begin :DrawShape(backgroundDrawing, nil); end, boardArray: nil, Move: func(p, x, y) begin // Check if this is a reasonable thing to do if :isTurn(p) and :validMove(p, x, y) then begin // Add the piece to the board :addPiece(p, x, y); // If this was a winner, let the user know if :winningMove(p, x, y) then begin winner := p; :announceWin(p); end // If this was a tie-maker, let the user know else if :tieGame() then begin winner := kTieWinner; :turn(kTieWinner); :announceWin(kTieWinner); end // Switch whose turn it is else :turn(-p); end; end, viewflags: 1553, viewIdleScript: func() begin // If we're real, it's the computer's turn, and there's no winner... if Visible(self) and :isTurn(kNewtonPiece) and (winner = nil) then begin // Put up the "Working..." sign, and figure the computer move :startWorking(); :makeComputerMove(); :stopWorking(); end; // Try again in a quarter of a second return 250; end, setupBoard: func() begin // Normally, there is no board set-up needed // This is overridden to add initial pieces to the board end, viewBounds: {left: 0, top: 32, right: 161, bottom: 193}, clearBoard: func() begin // Remove all the piece views, and redisplay local v; foreach v in :ChildViewFrames() do RemoveStepView(self, v); :Dirty(); // Clear out the boardArray local x, y; for x := 1 to squaresWide do for y := 1 to squaresHigh do boardArray[x][y] := kEmptySquare; // Reset the squares left squaresLeft := squaresWide * squaresHigh; // No winner yet winner := nil; // Do any game-specific board set-up :setupBoard(); end, player1Piece: GetPictAsBits("WPPicture", nil), makeRandomMove: func(p) begin // Try ten times to find a reasonable random move local i, x, y; for i := 1 to 10 do begin x := Random(1,squaresWide); y := Random(1,squaresHigh); if :validMove(p, x, y) then begin :move(p, x, y); return; end; end; // If that doesn't work, then just pick the first linear move for x := 1 to squaresWide do for y := 1 to squaresHigh do if :validMove(p, x, y) then begin :move(p, x, y); return; end; end, squaresLeft: nil, squareOfY: func(y) begin local gb := :GlobalBox(); if (y < gb.top) or (y > gb.bottom) then return 0; else return ((y - gb.top) div :squareHeight()) + 1; end, addPiece: func(p, x, y) begin // Mark the new piece in the boardArray boardArray[x][y] := p; // Check if there's already a view there in the view list local bounds := :squareBounds(x,y); local i := if p = kUserPiece then player1Piece else player2Piece; local v; foreach v in :ChildViewFrames() do if (v.viewBounds.top = bounds.top) and (v.viewBounds.left = bounds.left) then begin // If there is, replace the icon and redisplay SetValue(v, 'icon, i); return; end; // One less square available squaresLeft := squaresLeft - 1; // Create, add in, and display the new view AddStepView(self, { viewClass: clPictureView, viewBounds: :squareBounds(x, y), viewFlags: vVisible, icon: i }):Dirty(); end, winner: nil, validMove: func(p, x, y) begin // If it's an empty space, then it's legal to move there // This function may be overridden return boardArray[x][y] = kEmptySquare; end, squareWidth: func() begin return :LocalBox().right div squaresWide; end, winningMove: func(p, x, y) begin // By default, the computer never wins and the user wins when the board is full // This is always overridden, but we leave it in because it can be handy during // the early stages of developing a new game if p = kNewtonPiece then return nil else return squaresLeft = 0; end, backgroundDrawing: nil, viewSetupFormScript: func() begin // Register ourselves with the app AddArraySlot(boardList, self); // Make the board array; we make it one entry larger in each direction // than the board, which is nice sometimes when figuring out moves boardArray := Array(squaresWide+2, kEmptySquare); local i; for i := 0 to squaresWide+1 do begin boardArray[i] := Array(squaresHigh+2, if (i = 0) or (i = squaresWide+1) then kBoardEdge else kEmptySquare); boardArray[i][0] := kBoardEdge; boardArray[i][squaresHigh+1] := kBoardEdge; end; // Reset the number of squares left squaresLeft := squaresWide * squaresHigh; // No winner yet winner := nil; // Do any game-specfic set-up :setupBoard(); // Have our idle method called :SetUpIdle(250); end, viewClickScript: func(unit) begin // No ink (we're tapping, not drawing) InkOff(unit); // Make a nice little click to give the user warm fuzzies PlaySound(ROM_click); // But let the normal processing handle tracking and such return nil; end, squareOfX: func(x) begin local gb := :GlobalBox(); if (x < gb.left) or (x > gb.right) then return 0; else return ((x - gb.left) div :squareWidth()) + 1; end, squareHeight: func() begin return :LocalBox().bottom div squaresHigh; end, tieGame: func() begin // It's a tie if there's nothing left to do // This can be overridden return squaresLeft = 0; end, saveState: func() begin // Get the existing state entry, if any local stateEntry := :getStateEntry(); // If there isn't one yet, make one if stateEntry = nil then stateEntry := GetStores()[0]:GetSoup(ROM_SystemSoupName) :Add({Tag: kPackageName}); // If we can't make one, well, uh, let's just forget the whole thing if stateEntry = nil then return; // Build an array of pieces and their positions from the boardArray local x, y; local pieces := []; local ba := boardArray; for x := 1 to squaresWide do for y := 1 to squaresHigh do if ba[x][y] <> kEmptySquare then AddArraySlot(pieces, {player: ba[x][y], x: x, y: y}); // Remember which game this is, the piece positions, whose turn it is, and the winner stateEntry.name := name; stateEntry.pieces := pieces; stateEntry.whichTurn := :whoseTurn(); stateEntry.winner := winner; // Tell the soup to save the changed entry EntryChange(stateEntry); end, restoreState: func(stateEntry) begin // For each piece stored in the state entry, add it to the board local p; foreach p in stateEntry.pieces do :addPiece(p.player, p.x, p.y); // Set whose turn it is :turn(stateEntry.whichTurn); // Set the winner, if there is one winner := stateEntry.winner; end, viewJustify: 16, viewStrokeScript: func(unit) begin // Find out where we clicked to start with local originalX := :squareOfX(GetPoint(firstX, unit)); local originalY := :squareOfY(GetPoint(firstY, unit)); // If we ended where we started, then make the move if (originalX <> 0) and (originalY <> 0) and (originalX = :squareOfX(GetPoint(finalX, unit))) and (originalY = :squareOfY(GetPoint(finalY, unit))) then :move(kUserPiece, originalX, originalY); return true; end, viewclass: 74 }; Tictactoe := /* child of BoardGames */ { makeComputerMove: func() begin local moves := []; local bestScore := -1000; local newScore; local x, y; // Try each board position for x := 1 to squaresWide do for y := 1 to squaresHigh do if boardArray[x][y] = kEmptySquare then begin // Look ahead to score this move newScore := :tryMove(kUserPiece, kNewtonPiece, x, y); // If this is the best one yet, remember only it if newScore > bestScore then begin moves := []; bestScore := newScore; end; // If it's tied for best move, remember it too if newScore = bestScore then AddArraySlot(moves, {mvx: x, mvy: y}); end; // If there are any good moves... if Length(moves) > 0 then begin // Make the move local move := moves[Random(0,Length(moves)-1)]; :move(kNewtonPiece, move.mvx, move.mvy); end // If there are no good ones, then make a random one and pray else :makeRandomMove(kNewtonPiece); end, name: "Tic-tac-toe", player1Piece: GetPictAsBits("XPicture", nil), player2Piece: GetPictAsBits("OPicture", nil), squaresHigh: 3, squaresWide: 3 , tryMove: func(d, p, x, y) begin // First, guess based on heuristics // (Note: We use a quoted array here to save execution time; quoting // it means there will only be one copy -- without the quote a new // one would be constructed each time at run-time; of course, this // also means we can't change the contents, but we don't want to) local score := '[5, 0, 5, 5, 10, 5, 5, 0, 5][x+x+x+y-4]; // Make the move internally (we'll retract it later) local ba := boardArray; ba[x][y] := p; squaresLeft := squaresLeft - 1; // If it's a winner, great, give it a high score if :winningMove(p, x, y) then score := 100; // If there's anything to look ahead to, do it else if (squaresLeft <> 0) and (d > 0) then begin local worstResponse := 1000; local newResponse; local x2, y2; // Try every board position for x2 := 1 to squaresWide do for y2 := 1 to squaresHigh do if ba[x2][y2] = kEmptySquare then begin // How good is this one? newResponse := :tryMove(d-1, -p, x2, y2); // If it's a looser, then give up quick if newResponse >= 100 then begin ba[x][y] := nil; squaresLeft := squaresLeft + 1; return -100; end; // If it's the least bad one so far, remember that if newResponse < worstResponse then worstResponse := newResponse; end; score := score - worstResponse; end; // Retract the move ba[x][y] := kEmptySquare; squaresLeft := squaresLeft + 1; return score; end, viewSetupDoneScript: func() begin // Make an open cross-hatch (the default function does a closed board) local height := :LocalBox().bottom-1; local width := :LocalBox().right-1; local xIncr := :squareWidth(); local yIncr := :squareHeight(); backgroundDrawing := []; local x; for x := xIncr to width - xIncr by xIncr do AddArraySlot(backgroundDrawing, MakeLine(x,0,x,height)); local y; for y := yIncr to height - yIncr by yIncr do AddArraySlot(backgroundDrawing, MakeLine(0,y,width,y)); end, winningMove: func(p, x, y) begin local ba := boardArray; return ((ba[x][1] = p) and (ba[x][2] = p) and (ba[x][3] = p)) or ((ba[1][y] = p) and (ba[2][y] = p) and (ba[3][y] = p)) or ((ba[1][1] = p) and (ba[2][2] = p) and (ba[3][3] = p)) or ((ba[3][1] = p) and (ba[2][2] = p) and (ba[1][3] = p)); end, _proto: Board }; // View Tictactoe is accesible from BoardGames Reversi := /* child of BoardGames */ { Move: func(p, x, y) begin local x2, y2, c, d; local ba := boardArray; // Is it the proper turn and a valid move? if :isTurn(p) and :validMove(p, x, y) then begin // Check each horizontal, vertical, and diagonal direction for c := -1 to 1 do for d := -1 to 1 do begin // Scan out until we reach the edge or a piece x2 := x; y2 := y; while ba[x2+c][y2+d] = -p do begin x2 := x2 + c; y2 := y2 + d; end; // If we hit an opposing piece, then scan back // again and flip the pieces to the new color if ba[x2+c][y2+d] = p then loop begin :addPiece(p,x2,y2); if (x2 = x) and (y2 = y) then break; x2 := x2 - c; y2 := y2 - d; end; end; // Switch whose turn it is :turn(-p); end; end, makeComputerMove: func() begin local h, q, x, y, x2, y2, c, d, k, xm, ym; local ba := boardArray; // Check through all the possible moves h := 0; for x := 1 to squaresWide do for y := 1 to squaresHigh do if ba[x][y] = kEmptySquare then begin // Figure out how many squares would become ours q := 0; for c := -1 to 1 do for d := -1 to 1 do begin k := 0; x2 := x; y2 := y; while ba[x2+c][y2+d] = kUserPiece do begin k := k+1; x2 := x2 + c; y2 := y2 + d; end; if ba[x2+c][y2+d] = kNewtonPiece then q := q + k; end; // If it's an edge move, double its value if (x = 1) or (x = 8) or (y = 1) or (y = 8) then q := q*2 // If it's a next-to-edge move, half its value else if (x = 2) or (x = 7) or (y = 2) or (y = 7) then q := q/2; // If it's an edge next to a corner, half its value if ( ((x = 1) or (x = 8)) and ((y = 2) or (y = 7)) ) or ( ((x = 2) or (x = 7)) and ((y = 1) or (y = 8)) ) then q := q/2; // If it's the highest yet, or the same but chance favors it... if (q >= h) or ((q = h) and (Random(0,2) <> 0)) then begin // Remember this move h := q; xm := x; ym := y; end; end; // If we found a good move, make it if h <> 0 then begin :move(kNewtonPiece, xm, ym); if squaresLeft > 0 then return; end; // Now check for a winning or tying situation // We couldn't find a move or we wouldn't be here // Check if the user has a move open local pc := 0; local cc := 0; for x := 1 to squaresWide do for y := 1 to squaresHigh do if (ba[x][y] = kEmptySquare) and :validMove(kUserPiece, x, y) then begin :turn(kUserPiece); return; end else if ba[x][y] = kUserPiece then pc := pc + 1 else if ba[x][y] = kNewtonPiece then cc := cc + 1; // If not, then set the winner according to the piece counts if pc > cc then winner := kUserPiece else if cc > pc then winner := kNewtonPiece else winner := kTieWinner; :announceWin(winner); if winner = kTieWinner then :turn(kTieWinner); end, name: "Reversi", setupBoard: func() begin :addPiece(kNewtonPiece, 4, 4); :addPiece(kNewtonPiece, 5, 5); :addPiece(kUserPiece, 4, 5); :addPiece(kUserPiece, 5, 4); end, squaresHigh: 8, squaresWide: 8, tieGame: func() begin // In this game, we compute the winner whent the computer moves return winner = kTieWinner; end, validMove: func(p, x, y) begin // If the space is already taken, it isn't valid if boardArray[x][y] <> kEmptySquare then return nil; local c, d, x2, y2; local ba := boardArray; // Check is all directions for c := -1 to 1 do for d := -1 to 1 do begin // Look for a piece x2 := x+c; y2 := y+d; while ba[x2][y2] = -p do begin x2 := x2 + c; y2 := y2 + d; end; // If it's one of our pieces, // and there were some of the other color in between // then it's valid if (ba[x2][y2] = p) and (((x2-c) <> x) or ((y2-d) <> y)) then return true; end; // Otherwise, it isn't valid return nil; end, winningMove: func(p, x, y) begin // In this game, we compute the winner whent the computer moves return winner = p; end, _proto: Board }; // View Reversi is accesible from BoardGames Gomoku := /* child of BoardGames */ { makeComputerMove: func() begin local t, gx, gy, h1, l, p, k, m, i; local xInc, yInc, x, y, x2, y2, s; local ba := boardArray; // Make three passes over the board for t := 1 to 3 do begin // First and third checking our moves, second checking his p := if t = 2 then kUserPiece else kNewtonPiece; h1 := 0; l := 0; // Look at each possible move for x := 1 to squaresWide do for y := 1 to squaresHigh do if ba[x][y] = kEmptySquare then begin // Check the counts in each direction m := 0; for i := 0 to 3 do begin xInc := '[1, 1, 0, -1][i]; yInc := '[0, 1, 1, 1][i]; x2 := x + xInc; y2 := y + yInc; k := 0; while ba[x2][y2] = p do begin k := k + 10; x2 := x2 + xInc; y2 := y2 + yInc; end; if ba[x2][y2] = kEmptySquare then k := k + 1; xInc := -xInc; yInc := -yInc; x2 := x + xInc; y2 := y + yInc; while ba[x2][y2] = p do begin k := k + 10; x2 := x2 + xInc; y2 := y2 + yInc; end; if ba[x2][y2] = kEmptySquare then k := k + 1; // If this is the best move of this set, remember it if k > l then begin h1 := 0; l := k; end; // If it matches the best move so far, and it's a "good" // move, then increment it's overall value if k = l then if ((t = 1) and (l >= 40)) or (((t = 2) or (t = 3)) and (l >= 20)) then m := m + 1; end; // If this is the best move yet, remember it if m > h1 then begin h1 := m; gx := x; gy := y; end; end; // If we found a reasonable move, make it if h1 <> 0 then begin :move(kNewtonPiece, gx, gy); return; end; end; // If nothing seemed good, at least do something random :makeRandomMove(kNewtonPiece); end, makeRandomMove: func(p) begin // This is just like the default function, except it avoids // the edges of the board (which are really bad moves) // Try ten times to find a random move local i, x, y; for i := 1 to 10 do begin x := Random(2,squaresWide-1); y := Random(2,squaresHigh-1); if :validMove(p, x, y) then begin :move(p, x, y); return; end; end; // If that didn't work, just pick the first linear one for x := 1 to squaresWide do for y := 1 to squaredHigh do if :validMove(p, x, y) then begin :move(p, x, y); return; end; end, name: "Gomoku", squaresHigh: 8, squaresWide: 8, sumPieces: func(p, x, y) begin // Note: this function returns the number of pieces // in a row due to the given move, but does not include // the added piece -- so it returns the count minus one local ba := boardArray; local sum := 0; local i, xInc, yInc, x2, y2, s; // Try each potential direction for i := 0 to 3 do begin xInc := '[1, 1, 0, -1][i]; yInc := '[0, 1, 1, 1][i]; x2 := x + xInc; y2 := y + yInc; s := 0; while ba[x2][y2] = p do begin s := s + 1; x2 := x2 + xInc; y2 := y2 + yInc; end; xInc := -xInc; yInc := -yInc; x2 := x + xInc; y2 := y + yInc; while ba[x2][y2] = p do begin s := s + 1; x2 := x2 + xInc; y2 := y2 + yInc; end; // If this is the best sum yet, remember it if s > sum then sum := s; end; return sum; end, winningMove: func(p, x, y) begin return :sumPieces(p, x, y) >= 4; end, _proto: Board }; // View Gomoku is accesible from BoardGames